home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / fb386 / eiyoukei / ssort.bas < prev    next >
BASIC Source File  |  1994-06-01  |  1KB  |  35 lines
  1.    10 'SAVE "SSORT.BAS",A
  2.    20 '日本食品標準成分表SORT
  3.    30 '          V1.0                  91.04.10
  4.    35 CONSOLE 0,24,1:CLS:COLOR 7
  5.    40 OPEN "(128)SEIBUN.DAT" AS #1
  6.    50 FIELD #1,4 AS FC$,16+32 AS FS$
  7.    55 FIELD #1,128 AS FW$
  8.    60 N=LOF(1)
  9.    65 DIM S$(N),W$(N)
  10.    70 FOR I=1 TO N
  11.    75 GET #1,I:S$(I)=FS$:W$(I)=FW$':LSET FC$=MKS$(I):PUT #1,I
  12.    80 PRINT  USING "####    ";CVS(FC$);
  13.    90 PRINT  FS$
  14.   150 NEXT I
  15.  1000 *QSORT
  16.  1005 PRINT "ソート中ですしばらくおまちください｡"
  17.  1010 II=I:JJ=J:S=1:SL(1)=1:SR(1)=N
  18.  1020 L=SL(S):R=SR(S):S=S-1
  19.  1030 I=L:J=R:X$=S$(INT((L+R)/2))
  20.  1040 IF S$(I)<X$ THEN I=I+1:GOTO 1040
  21.  1050 IF X$<S$(J) THEN J=J-1:GOTO 1050
  22.  1060 IF I<=J THEN SWAP S$(I),S$(J):SWAP W$(I),W$(J):I=I+1:J=J-1
  23.  1070 IF I<=J THEN 1040
  24.  1080 IF I<R THEN S=S+1:SL(S)=I:SR(S)=R
  25.  1090 R=J
  26.  1100 IF L<R THEN 1030
  27.  1110 IF S<>0 THEN 1020
  28.  1120 I=II:J=JJ
  29.  1130 *QSORTEND
  30.  2000 FOR I=1 TO N
  31.  2005 LSET FW$=W$(I):PUT #1,I
  32.  2010 PRINT USING "####    ";CVS(MID$(W$(I),1,4));:PRINT S$(I)
  33.  2020 NEXT I
  34.  2030 CLOSE:RUN "MENTE.BAS"
  35.